#lang scheme

(provide o
         fo
         oerr
         ol)

;; TODO: SRFI/64
(provide true!
         false!
         equal!
         eq!
         =!
         not-eq!)

(provide delta-time)

(require srfi/1 ; any every
         mzlib/etc  ; identity
;         "assert.ss"
         )

;(define (id x) x)
;;;
;(define (o . x) (for-each (lambda(x)(printf "~s " x)) x) (printf "~n") )
(define (fo port . x) (for-each (lambda(x)(fprintf port "~s " x)) x) (fprintf port "~n") (apply values x))
(define o (curry fo (current-output-port)))
(define oerr (curry fo (current-error-port)))

(define (ol x) (for-each (lambda (x)(printf "~s~n" x)) x))

;;;
(define (equal! x . rest) ; all equal
  (unless (andmap (lambda (y) (equal? x y)) rest)
    (error "equal!" (cons x rest))))
  ; longer, but make the assert message cleaner
;  (let loop ([rest rest])
;    (when (pair? rest)
;      (let ([y (car rest)])
;        (assert (equal? y x)))
;      (loop (cdr rest))))
;  (void))

(define (true! x . rest)
  (unless (every identity (cons x rest))
    (error "true!" (cons x rest))))
;  (let loop ([rest (cons x rest)])
;    (when (pair? rest)
;      (let ([y (car rest)])
;        (assert y))
;      (loop (cdr rest))))
;  (void))

(define (false! x . rest)
  (when (any identity (cons x rest))
    (error "false!" (cons x rest))))

(define (eq! x . rest) ; all eq
  (unless (andmap (lambda (y) (eq? x y)) rest)
    (error "eq!" (cons x rest))))

(define (=! x . rest) ; all =
  (unless (andmap (lambda (y) (= x y)) rest)
    (error "=!" (cons x rest))))

(define (not-eq! x . rest) ; all different
  (when (ormap (lambda (y) (eq? x y)) rest)
    (error "not-eq!" (cons x rest))))

#;(define (exc! <block>)
  (let ([ok #f])
    (with-exception-handler
     (set! ok 1)
     <block>)
    (unless ok (error "exc!"))))

;;;
(define *first-delta-time* (current-inexact-milliseconds))
(define *last-delta-time* *first-delta-time*)
(define (delta-time)
  (define current (current-inexact-milliseconds))
  (define first-delta (- current *first-delta-time*))
  (define last-delta (- current *last-delta-time*))
  (set! *last-delta-time* current)
  (format "~a +~a" (/ first-delta 1000)  (/ last-delta 1000)))